home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / qwik5x.arc / QWIKDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-09  |  24KB  |  707 lines
  1. { =========================================================================== }
  2. { QwikDemo.pas - Demo program for QWIK screen utilities.    ver 5.x, 12-20-88 }
  3. { Demo has been programmed best for color cards in 25-line mode.              }
  4. { =========================================================================== }
  5.  
  6. { !! Do not use Ctrl-Break to terminate this program while in the }
  7. { TP integrated environment with integrated debugging on!! }
  8.  
  9. program QwikDemo;
  10.  
  11. { R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }       { TP4 directives }
  12. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}  { TP5 directives }
  13. {$M 12000, 0, 0}
  14.  
  15. uses
  16.   Crt,Qwik,Strs;
  17.  
  18. type
  19.   BrdrRec = record                 { For Qbox procedure }
  20.               TL,TH,TR,LV,RV,BL,BH,BR: char;
  21.             end;
  22.  
  23. var
  24.   Row,Rows,Col,Cols,Step,ColMax: byte;
  25.   i,Count,
  26.   Fgrnd,Bgrnd:         word;
  27.   BrdrAttr, WndwAttr:  integer;
  28.   SavedBlock, PopUpBlock: array [1..4000] of byte;
  29.   BlkRow,BlkCol,V:               byte;
  30.   ColL,ColR: array [1..3] of byte;
  31.   Strng,Strng2:          string[75];
  32.   Data: array [1..9 ] of string[40];
  33.   PC:   array [1..14] of string[40];
  34.   Init: array [1..10] of string[40];
  35.   Other:array [1..12] of string[40];
  36.   Crsr: array [1..13] of string[40];
  37.   Eoss: array [1.. 4] of string[40];
  38.   Rnum:                  Real;
  39.   Ch:                    char;
  40.   LastVideoMode:         byte;
  41.  
  42. const
  43.   Wait: word = 400;      { One unit of wait in milliseconds for demo. }
  44.   { These are double lines for Qbox }
  45.   Border: BrdrRec =  (TL:'╔';TH:'═';TR:'╗';
  46.                       LV:'║';       RV:'║';
  47.                       BL:'╚';BH:'═';BR:'╝');
  48.   BWcolors: array[0..3] of byte = (
  49.               Black,        { Black     on Black }
  50.               LightGray,    { LightGray on Black }
  51.               White,        { White     on Black }
  52.               LightGrayBG); { Black     on LightGray }
  53.  
  54. { Since Zenith doesn't have snow on any CGAs, turn off snow checking }
  55. procedure CheckZenith;
  56. var  ZdsRom: array[1..8] of char absolute $F000:$800C;
  57. begin
  58.   if Qsnow and (ZdsRom='ZDS CORP') then
  59.     begin
  60.       Qsnow    := false;
  61.       CardSnow := false;
  62.     end;
  63. end;
  64.  
  65. { Qbox is an application of QWIK screen utilities.  It can make fast
  66.   pop-up menus.  See WNDWxx.ARC for more applications. }
  67. procedure Qbox (Row,Col,Rows,Cols: byte; WndwAttr,BrdrAttr: integer;
  68.                                                       Brdr: BrdrRec);
  69. begin
  70.   if (Rows>=2) and (Cols>=2) then
  71.   begin
  72.     with Brdr do
  73.     begin
  74.       Qwrite    (Row       ,Col                     ,BrdrAttr,TL);
  75.       QfillEos  (                           1,Cols-2,BrdrAttr,TH);
  76.       QwriteEos (                                    BrdrAttr,TR);
  77.       Qfill     (Row+1     ,Col       ,Rows-2,1     ,BrdrAttr,LV);
  78.       Qfill     (Row+1     ,Col+Cols-1,Rows-2,1     ,BrdrAttr,RV);
  79.       Qwrite    (Row+Rows-1,Col                     ,BrdrAttr,BL);
  80.       QfillEos  (                           1,Cols-2,BrdrAttr,BH);
  81.       QwriteEos (                                    BrdrAttr,BR);
  82.       Qfill     (Row+1     ,Col+1     ,Rows-2,Cols-2,WndwAttr,' ')
  83.     end
  84.   end
  85. end;
  86.  
  87. procedure PromptKey;
  88. begin
  89.   Qwrite (25,CRTcols-19,SameAttr,'press any key ...');
  90.   Ch := ReadKey;
  91. end;
  92.  
  93. procedure ClearScreen (Attr: integer);
  94. begin
  95.   Qfill ( 1, 1,CRTrows,CRTcols,Attr,' ');
  96. end;
  97.  
  98. procedure ExplodeBoxes;
  99. var
  100.   TopRow,BottomRow,MaxRows,MaxCols,DeltaCols,LeftCol,RightCol: byte;
  101.   CenterCol:    byte;
  102.   ClockReading: word absolute $0040:$006C; { low memory clock }
  103.   StartTime:    word;
  104.  
  105. {}procedure ScatterBoxes;
  106. {}begin
  107. {}  Rows:= succ(random(MaxRows));
  108. {}  if QVideoMode<=CO40 then              { Keep aspect 1:1 }
  109. {}       Cols:= Rows + Rows shr 2         { 1.2 cols/row }
  110. {}  else Cols:= Rows shl 1 + Rows shr 1;  { 2.4 cols/row }
  111. {}  Col := LeftCol + random (RightCol-LeftCol-Cols+2);
  112. {}  Row := TopRow  + random (BottomRow-TopRow-Rows+2);
  113. {}  if QVideoMode=Mono then
  114. {}  TextAttr:=BWcolors[(random(4))]
  115. {}  else
  116. {}    begin
  117. {}      Fgrnd:= random (16);
  118. {}      Bgrnd:= random (8);
  119. {}      if Bgrnd=Fgrnd then inc(Fgrnd);
  120. {}      TextAttr:=Fgrnd + Bgrnd shl 4;
  121. {}    end;
  122. {}  Qfill (Row,Col,Rows,Cols,TextAttr,#178);
  123. {}end;
  124.  
  125. begin
  126.   CenterCol:=CRTcols shr 1;
  127.   randomize;
  128.   StartTime:=ClockReading;
  129.   for Step:=1 to 12 do
  130.     begin
  131.       { Set boundaries }
  132.       TopRow:=13-Step;
  133.       BottomRow:=13+Step;
  134.       MaxRows:=Step;
  135.       if QVideoMode<=CO40 then                      { Keep aspect 1:1 }
  136.         begin
  137.           MaxCols:= MaxRows + MaxRows shr 2;        { 1.2 cols/row }
  138.           DeltaCols:=(Step*5 div 3);
  139.         end
  140.       else
  141.         begin
  142.           MaxCols:= MaxRows shl 1 + MaxRows shr 1;  { 2.4 cols/row }
  143.           DeltaCols:=(Step*10 div 3);
  144.         end;
  145.       LeftCol  :=succ(CenterCol)-DeltaCols;
  146.       RightCol :=CenterCol+DeltaCols;
  147.       if Step<12 then
  148.         begin
  149.           for Count:=1 to 40 do ScatterBoxes;
  150.         end
  151.       else
  152.         repeat
  153.           ScatterBoxes;
  154.         until ClockReading-StartTime>=60;  { about 60/18.2 seconds }
  155.     end;
  156. end;
  157.  
  158. procedure InitDemo;
  159. begin
  160. { --- Set up data --- }
  161. { If you set a mode, do it first before Qinit! }
  162. { Please!  Test a mode first to see if it is different than what you want; }
  163. { then change if necessary.  Otherwise, the screen jumps. }
  164.  
  165.   CheckBreak := false;
  166.   CheckZenith;
  167.   LastVideoMode := QVideoMode;
  168.   if (QVideoMode<>Mono) and not Have3270 then
  169.     begin
  170.       ClearScreen (LightGray+BlackBG);
  171.       QwriteC (11,1,CRTcols,SameAttr,'(1) 40 column mode');
  172.       QwriteC (12,1,CRTcols,SameAttr,'(2) 80 column mode');
  173.       QwriteC (14,1,CRTcols,SameAttr,'Which mode [1,2]? ');
  174.       GotoEos;
  175.       repeat
  176.         Ch:=ReadKey;
  177.       until ch in ['1','2'];
  178.       V := QVideoMode;
  179.       case ch of
  180.         '1': case V of
  181.                BW80: V:=BW40;
  182.                CO80: V:=CO40;
  183.              end;
  184.         '2': case V of
  185.                BW40: V:=BW80;
  186.                CO40: V:=CO80;
  187.              end;
  188.       end;
  189.       if V<>QVideoMode then
  190.         begin
  191.           TextMode (V+hi(LastMode));
  192.           Qinit;           { << Do Qinit again after change of mode!! }
  193.           CheckZenith;
  194.         end;
  195.     end;
  196.   ModCursor (CursorOff);
  197.   Strng:=   ' Q Screen Utilities ';
  198.   Strng2:=  ' QWIK Screen Utilities  ';
  199.   Data[1]:= '1';
  200.   Data[2]:= '22';
  201.   Data[3]:= '333';
  202.   Data[4]:= Strng;
  203.   Data[5]:= 'Odd  Length';
  204.   Data[6]:= 'Even  Length';
  205.   Data[7]:= '18 characters wide';
  206.   Data[8]:= '19 characters width';
  207.   Data[9]:= 'Margin to Margin width';
  208.   PC[1]:=  'COMPUTERS:           ADAPTERS:';
  209.   PC[2]:=  '------------------   ----------';
  210.   PC[3]:=  'IBM PC               MDA';
  211.   PC[4]:=  'IBM XT               CGA';
  212.   PC[5]:=  'IBM AT               EGA';
  213.   PC[6]:=  'IBM PCjr             MCGA';
  214.   PC[7]:=  'IBM PC Convertible   VGA';
  215.   PC[8]:=  'IBM PS/2 Model 25    8514/A';
  216.   PC[9]:=  'IBM PS/2 Model 30    Hercules:';
  217.   PC[10]:= 'IBM PS/2 Model 50      HGC';
  218.   PC[11]:= 'IBM PS/2 Model 60      HGC Plus';
  219.   PC[12]:= 'IBM PS/2 Model 70      InColor';
  220.   PC[13]:= 'IBM PS/2 Model 80';
  221.   PC[14]:= 'IBM 3270 PC';
  222.   Other[ 1]:='QscrollUp  - Qwik scroll up';
  223.   Other[ 2]:='QscrollDown- Qwik scroll down';
  224.   Other[ 3]:='QscrToVscr - block to virtual screen';
  225.   Other[ 4]:='QVscrToScr - virtual screen to block';
  226.   Other[ 5]:='QreadStr   - reads string from screen';
  227.   Other[ 6]:='QreadChar  - reads char   from screen';
  228.   Other[ 7]:='QreadAttr  - reads attr   from screen';
  229.   Other[ 8]:='QviewPage  - view any video page';
  230.   Other[ 9]:='QwritePage - write to any video page';
  231.   Other[10]:='QwriteA    - for arrays/partial strings';
  232.   Other[11]:='QfillC     - a self-centering Qfill';
  233.   Other[12]:='QattrC     - a self-centering Qattr';
  234.   Crsr[ 1]:='GotoRC        - absolute cursor position';
  235.   Crsr[ 2]:='WhereR        - absolute cursor row';
  236.   Crsr[ 3]:='WhereC        - absolute cursor column';
  237.   Crsr[ 4]:='SetCursor     - sets cursor mode';
  238.   Crsr[ 5]:='GetCursor     - gets cursor mode';
  239.   Crsr[ 6]:='ModCursor     - modifies cursor mode';
  240.   Crsr[ 7]:='CursorInitial   - cursor at startup';
  241.   Crsr[ 8]:='CursorUnderline - normal cursor';
  242.   Crsr[ 9]:='CursorHalfBlock - for insert editing';
  243.   Crsr[10]:='CursorBlock     - for the nearsighted';
  244.   Crsr[11]:='A total of 38 utilities';
  245.   Crsr[12]:='optimizing in just 2.5k bytes or less!';
  246.   Init[1]:='∙ Detects dual monitor/adapters for all';
  247.   Init[2]:='   systems listed on the previous page';
  248.   Init[3]:='∙ Identifies each system by name';
  249.   Init[4]:='∙ Gets System ID and Submodel ID';
  250.   Init[5]:='∙ Gets CPU ID';
  251.   Init[6]:='∙ Sets FAR pointer for virtual screens';
  252.   Init[7]:='∙ Determines need for wait-for-retrace';
  253.   Init[8]:='∙ Gets screen dimensions: Rows by Cols';
  254.   Init[9]:='∙ Determines the number of video pages';
  255.   Init[10]:='∙ Sets 4 standard cursor shapes';
  256.   Eoss[1]:=' ∙ QwriteEos  - just like Qwrite  ';
  257.   Eoss[2]:=' ∙ QwriteEosA - just like QwriteA ';
  258.   Eoss[3]:=' ∙ QfillEos   - just like Qfill   ';
  259.   Eoss[4]:=' ∙ QattrEos   - just like Qattr   ';
  260. end;
  261.  
  262. procedure ExplodeScreen;
  263. begin
  264.   { --- Initial screen --- }
  265.   ClearScreen (White+BlueBG);
  266.   QwriteC (11, 1,CRTcols,Yellow+BlueBG,Strng2);
  267.   QwriteC (13, 1,CRTcols,SameAttr,'Your screen is about to explode.');
  268.   QwriteC (14, 1,CRTcols,SameAttr,'Hold on to your seat ...');
  269.   Delay   (Wait*5);
  270.  
  271.   { --- Explosion of Boxes --- }
  272.   ClearScreen (Black+LightGrayBG);
  273.   ExplodeBoxes;
  274.  
  275.   QfillC  (10, 1,CRTcols, 6,34,RedBG  ,' ');
  276.   QfillC  (11, 1,CRTcols, 4,30,BrownBG,' ');
  277.   TextAttr:= Yellow+RedBG;
  278.   QwriteC (12, 1,CRTcols,TextAttr,Strng2);
  279.   QwriteC (13, 1,CRTcols,TextAttr,'      Version  5.x      ');
  280. end;
  281.  
  282. procedure SaveScreen;
  283. begin
  284.   { --- Save Screen for Page Demo --- }
  285.   if MaxPage>0 then
  286.    begin
  287.      QstoreToMem ( 1, 1,25,CRTcols,SavedBlock);
  288.      QwritePage  (1);
  289.      QstoreToScr ( 1, 1,25,CRTcols,SavedBlock);
  290.      QwritePage  (0);
  291.    end;
  292.   { --- End of Save Screen --- }
  293.   Delay   (Wait*4);
  294.   TextAttr:= White+BlueBG;
  295.   QwriteC ( 6, 1,CRTcols,TextAttr,' Qwrite will write with new attributes  ');
  296.   QwriteC ( 7, 1,CRTcols,TextAttr,' that you specify direct to the screen. ');
  297.   Delay   (Wait*6);
  298.   QwriteC (18, 1,CRTcols,SameAttr,'Qwrite will also use existing attributes');
  299.   QwriteC (19, 1,CRTcols,SameAttr,'   when you do not even know or care.   ');
  300.                         { highlight the word 'existing' }
  301.   QattrC  (18, 6,CRTcols+5,1,10,White+RedBG+Blink);
  302.   Delay   (wait*10);
  303.   QwriteC (21, 1,CRTcols,TextAttr,' Say Goodbye to this screen. ');
  304.  
  305.   Delay   (wait*3);
  306.   { --- Disintigrate Screen --- }
  307.   for i:=1 to 5000 do
  308.   begin
  309.     Row:=random(25)+1;
  310.     Col:=random(CRTcols)+1;
  311.     Qfill (row,col, 1, 1,Black,' ');
  312.   end;
  313. end;
  314.  
  315. procedure ListCompatibles;
  316. begin
  317.   { --- Compatible computer and adapter list --- }
  318.   ClearScreen (LightGrayBG);
  319.   QwriteC ( 4, 1,CRTcols,SameAttr,'QWIK Screen Utilities detects these IBM');
  320.   QwriteC ( 5, 1,CRTcols,SameAttr,'or compatible computers and adapters:');
  321.   delay   (wait*5);
  322.   Col:=(CRTcols-30) shr 1;
  323.   for Row:=7 to 20 do
  324.     Qwrite (Row,Col,SameAttr,PC[Row-6]);
  325.   QwriteC (23, 1,CRTcols,SameAttr,'Working text modes 0,1,2,3, or 7!');
  326.   PromptKey;
  327. end;
  328.  
  329. procedure ListDetection;
  330. begin
  331.   { --- Qinit detection --- }
  332.   ClearScreen (LightGrayBG);
  333.   QwriteC ( 4, 1,CRTcols,SameAttr,'To configure QWIK, Qinit not only');
  334.   QwriteC ( 5, 1,CRTcols,SameAttr,'detects computers/adapters, it:');
  335.   delay   (wait*5);
  336.   Col:=(CRTcols-36) shr 1;
  337.   for Row:=10 to 19 do
  338.     Qwrite (Row,Col,SameAttr,Init[Row-9]);
  339.   PromptKey;
  340. end;
  341.  
  342. procedure UsingStr;
  343. begin
  344.   { --- Qwrite with Str on Reals Demo --- }
  345.   ClearScreen (Yellow+BlackBG);
  346.   QwriteC ( 2, 1,CRTcols,SameAttr,'Qwrite with the Strs unit will write');
  347.   QwriteC ( 3, 1,CRTcols,SameAttr,'reals and integers faster:');
  348.   Delay   (wait*7);
  349.   Rnum:=1.23E+05;
  350.   for col:=0 to CRTcols div 20 -1 do
  351.   for row:=5 to 24 do
  352.   begin
  353.     Rnum:=Rnum+1;
  354.     Qwrite (row,col*20+4,SameAttr,StrRF(Rnum,12));
  355.   end;
  356.   PromptKey;
  357. end;
  358.  
  359. procedure Centering;
  360. begin
  361.   { --- Centering Demo --- }
  362.   ClearScreen (LightGrayBG);
  363.   QwriteC ( 2, 1,CRTcols,SameAttr,'QwriteC will automatically');
  364.   QwriteC ( 3, 1,CRTcols,SameAttr,'center your data ...');
  365.   QwriteC ( 4, 1,CRTcols,SameAttr,'(Odd breaks are shifted to the left.)');
  366.   Delay   (wait*6);
  367.  
  368.   { - Set up columns for varying column modes - }
  369.   ColL[2]:=1; ColR[2]:=CRTcols;
  370.   if CRTcols<80 then
  371.   begin
  372.     ColL[1]:=ColL[2]; ColL[3]:=CRTcols div 2;
  373.     ColR[1]:=ColR[2]; ColR[3]:=CRTcols div 2;
  374.   end
  375.   else
  376.   begin
  377.     ColL[1]:=3; ColR[1]:=26; ColL[3]:=CRTcols-14; ColR[3]:=CRTcols-14;
  378.   end;
  379.  
  380.   QwriteC ( 7,ColL[1],ColR[1],SameAttr,'between margins ...');
  381.   Qbox    ( 8,(ColL[1]+ColR[1]) shr 1 -12,15,26,white,LightGray,Border);
  382.   Delay   (wait*3);
  383.   for row:=11 to 19 do
  384.     QwriteC (row,ColL[1],ColR[1],SameAttr, Data[row-10]);
  385.   Delay   (wait*5);
  386.  
  387.   QwriteC ( 7,ColL[2],ColR[2],SameAttr,'between two columns ...');
  388.   QfillC  ( 9,ColL[2],ColR[2],13,24,Yellow,' ');     {  Clear window }
  389.   for row:= 9 to 21 do
  390.     QwriteC  (row,ColL[2],ColR[2],SameAttr,'><');     {  Show two columns  }
  391.   Delay   (wait*3);
  392.   for row:=11 to 19 do
  393.     QwriteC (row,ColL[2],ColR[2],LightRed, Data[row-10]);
  394.   Delay   (wait*5);
  395.  
  396.   QwriteC ( 7,ColL[3],ColR[3],SameAttr,'or on a center line ...');
  397.   QfillC  ( 8,ColL[3],ColR[3],15,27,Black+LightGrayBG,' ');  {Clear window}
  398.   for row:=09 to 21 do                 {  Show center line  }
  399.     QwriteC  (row,ColL[3],ColR[3],Black+LightGrayBG,'|');
  400.   Delay   (wait*3);
  401.   for row:=11 to 19 do
  402.     QwriteC (row,ColL[3],ColR[3],SameAttr, Data[row-10]);
  403.   PromptKey;
  404. end;
  405.  
  406. procedure QwikFilling;
  407. begin
  408.   { --- Qfill Demo --- }
  409.   ClearScreen (White+BlackBG);
  410.   QwriteC ( 2, 1,CRTcols,SameAttr,'Qfill as well as Qattr can fill');
  411.   QwriteC ( 3, 1,CRTcols,SameAttr,'your screen in several ways.');
  412.   Delay   (wait*7);
  413.  
  414.   QwriteC ( 7, 1,CRTcols,SameAttr,'by rows ...');
  415.   Delay   (wait*3);
  416.   for row:= 9 to 24 do
  417.     Qfill (row, 2, 1,CRTcols-2,9+row,Chr(row+56));
  418.   Delay   (wait*5);
  419.  
  420.   Qfill   ( 7, 1,19,CRTcols,white,' ');       {  Clear Lines }
  421.   QwriteC ( 7, 1,CRTcols,SameAttr,'by columns ...');
  422.   Delay   (wait*3);
  423.   for col:=2 to CRTcols-2 do
  424.     Qfill ( 9,col,16,1,16+col,chr(col+63));
  425.   Delay   (wait*5);
  426.  
  427.   Qfill   ( 7, 1,19,CRTcols,white,' ');       {  Clear Lines }
  428.   QwriteC ( 7, 1,CRTcols,SameAttr,'or by row-by-column blocks ...');
  429.   Delay   (wait*3);
  430.     Qfill ( 9,2,16,CRTcols-2,Yellow+BlueBG,'!');
  431.   Delay   (wait*5);
  432. end;
  433.  
  434. procedure QboxDemo;
  435. begin
  436.   { --- Qbox demo --- }
  437.   ClearScreen (LightGrayBG);
  438.   QwriteC ( 2, 1,CRTcols,SameAttr,'Qbox is an application procedure made');
  439.   QwriteC ( 3, 1,CRTcols,SameAttr,'from Qwrite and Qfill.  Together they');
  440.   QwriteC ( 4, 1,CRTcols,SameAttr,'can make windows with borders easy.');
  441.   Delay   (wait*9);
  442.   QwriteC (14, 1,CRTcols,SameAttr,'How about 100 of them? ... ');
  443.   Delay   (wait*4);
  444.   ColMax:=CRTcols-21;
  445.   for i:=1 to 100 do
  446.   begin
  447.     row:=random (10)+6;
  448.     col:=random (ColMax)+2;
  449.     if QVideoMode=Mono then
  450.       begin
  451.         BrdrAttr:=BWcolors[random(4)];
  452.         WndwAttr:=BWcolors[random(4)];
  453.       end
  454.     else
  455.       begin
  456.         BrdrAttr:=random (128);
  457.         WndwAttr:=random (128);
  458.       end;
  459.     Qbox (row,col,10,20,BrdrAttr,WndwAttr,Border);
  460.   end;
  461.   Delay   (wait*10);
  462. end;
  463.  
  464. procedure PopUpDemo;
  465. begin
  466.   { --- Block Transfer and PopUp Demo --- }
  467.   Qfill   ( 1, 1,25,CRTcols,yellow,'?');       {  Clear Screen }
  468.   QfillC  (10, 1,CRTcols, 6,40,BrownBG,' ');   {  Clear Block }
  469.   QwriteC (11, 1,CRTcols,SameAttr,'Qstore will save and restore');
  470.   QwriteC (12, 1,CRTcols,SameAttr,'Row-by-Column blocks on your display.');
  471.   QwriteC (13, 1,CRTcols,SameAttr,'It is so fast, I have to slow it down');
  472.   QwriteC (14, 1,CRTcols,SameAttr,'so you can see it.');
  473.     Delay (wait*11);
  474.     BlkRow:=8;
  475.     BlkCol:=CRTcols div 2 - 9;
  476.   QstoreToMem(BlkRow,BlkCol,10,20,SavedBlock);
  477.   { --- Make a Pop Up Menu --- }
  478.   Qbox (BlkRow,BlkCol,10,20,Yellow+BlueBG,Brown+BlueBG,Border);
  479.   QwriteC (BlkRow+4,BlkCol,BlkCol+20,SameAttr,'Pop Up');
  480.   QwriteC (BlkRow+5,BlkCol,BlkCol+20,SameAttr,'Menu');
  481.   { --- End of Pop Up Menu --- }
  482.   QstoreToMem (BlkRow,BlkCol,10,20,PopUpBlock);
  483.     Delay (wait*4);
  484.   ColMax:=CRTcols-20;
  485.   for i:=1 to 30 do
  486.   begin
  487.     Delay (Wait div 2);
  488.     QstoreToScr (BlkRow,BlkCol,10,20,SavedBlock);
  489.     BlkRow:=random(15)+1;
  490.     BlkCol:=random(ColMax)+1;
  491.     QstoreToMem (BlkRow,BlkCol,10,20,SavedBlock);
  492.     QstoreToScr (BlkRow,BlkCol,10,20,PopUpBlock);
  493.   end;
  494. end;
  495.  
  496. procedure PageDemo;
  497. begin
  498.   { --- Page Demo --- }
  499.   if MaxPage>0 then
  500.   begin
  501.     QviewPage  (1);
  502.     QwritePage (1);
  503.     TextAttr:= Yellow+BlueBG;
  504.     QfillC  (20, 1,CRTcols, 3,40,TextAttr,' ');
  505.     QwriteC (20, 1,CRTcols,SameAttr,' Remember this page?  ');
  506.     QwriteC (21, 1,CRTcols,SameAttr,' It wasn''t destroyed, but saved using ');
  507.     QwriteC (22, 1,CRTcols,SameAttr,' Qstores and placed on a new page. ');
  508.     Delay (wait*14);
  509.     QwritePage (0);
  510.     QviewPage  (0);
  511.   end;
  512. end;
  513.  
  514. procedure EosMarker;
  515. var Row: byte;
  516. begin
  517.   { -- EOS marker -- }
  518.   ClearScreen (LightGreen+BlackBG);
  519.   QwriteC ( 3, 1,CRTcols,White,'EOS Marker:');
  520.   Col := EosC;
  521.   QwriteEos (Blink+Yellow,#07);
  522.   Qwrite  ( 4,Col,Yellow,#24' right here');
  523.   QwriteC ( 7, 1,CRTcols,SameAttr,'The TP Write procedure locates your next');
  524.   QwriteC ( 8, 1,CRTcols,SameAttr,'string by placing the cursor at the EOS ');
  525.   QwriteC ( 9, 1,CRTcols,SameAttr,'(End-Of-String).  Qwik procedures can do');
  526.   QwriteC (10, 1,CRTcols,SameAttr,'the same thing, but without moving the  ');
  527.   QwriteC (11, 1,CRTcols,SameAttr,'cursor!  It''s done with an offset called');
  528.   QwriteC (12, 1,CRTcols,SameAttr,'QEosOfs.  It''s updated after every Qwik ');
  529.   QwriteC (13, 1,CRTcols,SameAttr,'procedure.                              ');
  530.   QwriteC (16, 1,CRTcols,SameAttr,'Now you can have the convenience of a TP');
  531.   QwriteC (17, 1,CRTcols,SameAttr,'write but the speed of Qwik!  Check out ');
  532.   QwriteC (18, 1,CRTcols,SameAttr,'the following Q*Eos procedures.         ');
  533.   PromptKey;
  534. end;
  535.  
  536. procedure QEosDemo;
  537. begin
  538.   { --- Q*Eos Utilities Demo --- }
  539.   ClearScreen (Black+LightGrayBG);
  540.   QwriteC ( 3, 1,CRTcols,SameAttr,'The Q*Eos procedures:');
  541.   for Row:=5 to 8 do
  542.     QwriteC (Row, 1,CRTcols,Yellow+BlackBG,Eoss[Row-4]);
  543.   QwriteC (10, 1,CRTcols,SameAttr,'Take advantage of the EOS marker to');
  544.   QwriteC (11, 1,CRTcols,SameAttr,'chain the next string - with an    ');
  545.   QwriteC (12, 1,CRTcols,SameAttr,'optional change of attribute!      ');
  546.   delay   (wait*5);
  547.   Col := (CRTcols-38) shr 1;
  548.     Qwrite (14,Col,Black+BrownBG,' Yellow ');
  549.     for Count:=1 to 2 do
  550.       begin
  551.         delay      (wait);
  552.         QwriteEos (White+BlueBG ,'  Blue  ');
  553.         delay      (wait);
  554.         QwriteEos (Black+BrownBG,' Yellow ');
  555.       end;
  556.   delay   (wait);
  557.   QwriteC (16, 1,CRTcols,SameAttr,'Starts where the last Qwik');
  558.   QwriteC (17, 1,CRTcols,SameAttr,'procedure left off!');
  559.   QwriteC (18, 1,CRTcols,SameAttr,'Like TP Write ... but at Qwik speeds!');
  560.   delay   (wait*2);
  561.     Qwrite (21,Col,Black+BrownBG,' Yellow ');
  562.     for Count:=1 to 2 do
  563.       begin
  564.         QwriteEos (White+BlueBG ,'  Blue  ');
  565.         QwriteEos (Black+BrownBG,' Yellow ');
  566.       end;
  567.   PromptKey;
  568. end;
  569.  
  570. procedure UsingEos;
  571. begin
  572.   { -- Using Eos marker -- }
  573.   ClearScreen (Black+LightGrayBG);
  574.   Col:=succ((CRTcols-40) shr 1);
  575.   QwriteC ( 2, 1,CRTcols,White,' Using the EOS marker: ');
  576.   Qwrite ( 4,Col,SameAttr,'Now you have two marker utilities -');
  577.   Qwrite ( 5,Col,SameAttr,'(1) EOS, and (2) the cursor.  Both can');
  578.   Qwrite ( 6,Col,SameAttr,'be used interchangeably:');
  579.   Qwrite ( 8,Col,SameAttr,'GotoEos   - cursor to End-Of-String');
  580.   Qwrite ( 9,Col,SameAttr,'EosR      - End-Of-String row');
  581.   Qwrite (10,Col,SameAttr,'EosC      - End-Of-String column');
  582.   Qwrite (12,Col,SameAttr,'You can also manually alter EOS with the');
  583.   Qwrite (13,Col,SameAttr,'following procedures:');
  584.   Qwrite (15,Col,SameAttr,'EosToRC     - Sets EOS to a given row');
  585.   Qwrite (16,Col,SameAttr,'              and column.');
  586.   Qwrite (17,Col,SameAttr,'EosToRCrel  - Relatively shifts EOS by');
  587.   Qwrite (18,Col,SameAttr,'              row and column.');
  588.   Qwrite (19,Col,SameAttr,'EosToCursor - Matches Eos to the cursor');
  589.   Qwrite (20,Col,SameAttr,'              position.');
  590.   Qwrite (21,Col,SameAttr,'EosLn       - Sets EOS to next row');
  591.   Qwrite (22,Col,SameAttr,'QEosLn      - Like EosLn, but scrolls up');
  592.   Qwrite (23,Col,SameAttr,'              if on last row.');
  593.   PromptKey;
  594. end;
  595.  
  596. procedure MoreUtilities;
  597. begin
  598.   { --- Other Screen Utilities Demo --- }
  599.   ClearScreen (Black+LightGrayBG);
  600.   QwriteC ( 3, 1,CRTcols,SameAttr,'Here are more powerful');
  601.   QwriteC ( 4, 1,CRTcols,SameAttr,'QWIK Screen Utilities');
  602.   QwriteC ( 5, 1,CRTcols,SameAttr,'(for standard and virtual):');
  603.   delay   (wait*5);
  604.   Col:=(CRTcols-38) shr 1;
  605.   for Row:=8 to 19 do
  606.     Qwrite (Row,Col,SameAttr,Other[Row-7]);
  607.   PromptKey;
  608. end;
  609.  
  610. procedure CursorUtilities;
  611. begin
  612.   { --- Cursor Utilities Demo --- }
  613.   ClearScreen (Black+BrownBG);
  614.   QwriteC ( 1, 1,CRTcols,SameAttr,'And of course there are complete');
  615.   QwriteC ( 2, 1,CRTcols,SameAttr,'set of CURSOR location and mode ');
  616.   QwriteC ( 3, 1,CRTcols,SameAttr,'routines for all video pages and');
  617.   QwriteC ( 4, 1,CRTcols,SameAttr,'video cards:                    ');
  618.   delay   (wait*5);
  619.   Col:=(CRTcols-38) shr 1;
  620.   for Row:= 6 to 11 do
  621.     Qwrite (Row,Col,SameAttr,Crsr[Row-5]);
  622.   QwriteC (13, 1,CRTcols,SameAttr,'For universal cursor sizes, four');
  623.   QwriteC (14, 1,CRTcols,SameAttr,'standard shapes are initialized ');
  624.   QwriteC (15, 1,CRTcols,SameAttr,'by detecting each video card:   ');
  625.   for Row:=17 to 20 do
  626.     Qwrite (Row,Col,SameAttr,Crsr[Row-10]);
  627.   for Row:=22 to 23 do
  628.     QwriteC (Row,1,CRTcols,SameAttr,Crsr[Row-11]);
  629.   PromptKey;
  630. end;
  631.  
  632. procedure AttrDemo;
  633. begin
  634.   { --- Attribute Demo --- }
  635.   ClearScreen (Green+GreenBG);
  636.   TextAttr:= White+GreenBG;
  637.   QwriteC ( 2, 1,CRTcols,TextAttr,'QWIK Screen Utilities are hiding data');
  638.   QwriteC ( 3, 1,CRTcols,TextAttr,'on your screen ...');
  639.   Cols:=CRTcols div 20;
  640.   if QVideoMode=Mono then
  641.        TextAttr:=Black+BlackBG
  642.   else TextAttr:=Green+GreenBG;
  643.   for col:=0 to Cols-1 do
  644.     for row:=5 to 20 do
  645.       Qwrite (row,20*col+1,TextAttr,Strng);
  646.   Delay (wait*8);
  647.  
  648.   Qfill   ( 2, 1, 2,CRTcols,SameAttr,' ');        {  Clear Lines }
  649.   TextAttr:= White+GreenBG;
  650.   QwriteC ( 2, 1,CRTcols,TextAttr,'Qattr can show them -');
  651.   QwriteC ( 3, 1,CRTcols,TextAttr,'by merely changing the attribute!');
  652.   Delay   (wait*6);
  653.  
  654.   { --- Try using Turbo's color procedures this time --- }
  655.   TextColor (Black); TextBackground (Green);
  656.   Qattr   ( 5, 1,16,CRTcols,TextAttr);         {  Reveal Data }
  657.   Delay   (wait*5);
  658.  
  659.   Qfill   ( 2, 1, 2,CRTcols,SameAttr,' ');        {  Clear Lines }
  660.   TextColor (yellow); TextBackground (Green);
  661.   QwriteC ( 2, 1,CRTcols,TextAttr,'Or even just emphasize what''s seen ...');
  662.   for i:=1 to 500 do
  663.   begin
  664.     Row:= random(16) + 5;
  665.     Col:= random(Cols)*20+1;
  666.     Qattr (Row,Col, 1,20,46);
  667.     Delay (3);
  668.     Qattr (Row,Col, 1,20,32);
  669.   end;
  670.   for i:=1 to Cols do     {  Emphasize Data }
  671.     Qattr ( 5*i,(i-1)*20+1, 1,20,Yellow+GreenBG+Blink);
  672.   Qattr   (21, 1, 5,CRTcols,TextAttr);
  673.   QwriteC (22, 1,CRTcols,TextAttr,' (c) 1986-1988 James H. LeMay ');
  674. end;
  675.  
  676. procedure CloseDemo;
  677. begin
  678.   if QVideoMode<=CO40 then
  679.     begin
  680.       delay (Wait*4);
  681.       TextMode (LastVideoMode+hi(LastMode));
  682.     end;
  683.   GotoRC (23, 1);
  684.   SetCursor (CursorInitial);
  685. end;
  686.  
  687. begin
  688.   InitDemo;
  689.   ExplodeScreen;
  690.   SaveScreen;
  691.   ListCompatibles;
  692.   ListDetection;
  693.   UsingStr;
  694.   Centering;
  695.   QwikFilling;
  696.   QboxDemo;
  697.   PopUpDemo;
  698.   PageDemo;
  699.   EosMarker;
  700.   QEosDemo;
  701.   UsingEos;
  702.   MoreUtilities;
  703.   CursorUtilities;
  704.   AttrDemo;
  705.   CloseDemo;
  706. end.
  707.